#### Functions to source for other scripts
#### Agreement and Mode
#### JBS: 23 September 2016
#############################

### The agreefunc relies on the agrmt package for the collapse function. This must be loaded
### Need multilevel for rwg function

## Mode Function
Mode <- function(x, na.rm = FALSE) {
  if(na.rm){
   x = x[!is.na(x)]
   }

   u <- which(tabulate(x)==max(tabulate(x)))

 if(length(u)>1){
 	u <- sample(u,1)
 }
 return(u)
}

## Function to calculate different types of agreement

agreefunc <- function(dim,dim.name,pid,scale) {

	dim.pid <-unclass(by(dim[!is.na(dim)], pid[!is.na(dim)], agrmt::collapse , pos=scale[1]:scale[2]))

	dim.eijk <- unlist(lapply(dim.pid, agreement))

	dim.eijk <- cbind(names(dim.eijk), dim.eijk)

	colnames(dim.eijk) <-c("grpid","dim.eijk")
	dim.eijk<-data.frame(dim.eijk)

	# SD
	dim.sd<-aggregate(dim,list(pid),sd,na.rm=T)
	names(dim.sd)<-c("grpid","sd")


	rv <- (length(seq(scale[1],scale[2]))^2-1)/12

	# triangular distribution
	if((length(seq(scale[1],scale[2])) %% 2) == 1) {
	rv.triangular <- ((length(seq(scale[1],scale[2]))-1)*(length(seq(scale[1],scale[2]))+3)/24)
	} else {
	rv.triangular <- (length(seq(scale[1],scale[2]))^2+2*(length(seq(scale[1],scale[2])))-2)/24
	}


	dim.rwg <-data.frame(rwg(dim,grpid=pid,ranvar=rv))
	dim.rwg.triangular <-data.frame(rwg(dim,grpid=pid,ranvar=rv.triangular))
	names(dim.rwg.triangular)[2:3]<-c("triangrwg","gsize")


	dim.agr <- join_all(list(dim.eijk,dim.rwg,dim.rwg.triangular,dim.sd),by="grpid",type="full")

	names(dim.agr)<-c("party.id",paste(dim.name,"eijk",sep="."),paste(dim.name,"rwg",sep="."),"numresp",paste(dim.name,"triangrwg",sep="."),paste(dim.name,"sd",sep="."))

	dim.agr <- as.data.frame(dim.agr)

	return(dim.agr)
}

# Function for bootstrapping

bootexperts <- function(dimdata,pid,nsims,mode=T) {

	myboot <- NULL

	# Expert placements rescaled to 1-10 scale (for Adams et al replication)
	 dimdata <- (1.5*dimdata)-0.5

	# bootstrap and calculate the modal party position for each bootstrap
	if (mode==T) {
		for (i in 1:nsims) {

		myboot<-cbind(myboot,as.matrix(unlist(lapply(by(dimdata[!is.na(dimdata)],pid[!is.na(dimdata)],sample,replace=T),Mode))))

		}
	}

	else{
		for (i in 1:nsims) {

		myboot<-cbind(myboot,as.matrix(unlist(lapply(by(dimdata[!is.na(dimdata)],pid[!is.na(dimdata)],sample,replace=T),median))))

		}
	}


	return(as.data.frame(myboot))

}

